home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d10
/
ps1410.arc
/
CAL1.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-10-31
|
35KB
|
842 lines
'=========================================================================
' Personal Calendar (PC) Program
' Copyright (c) 1985-1990, Paul Munoz-Colman. All Rights Reserved.
' Version 14.10
' 31 Oct 1990
' Shareware $25
'=========================================================================
' DOS File CAL1.BAS
' Main Program
'=========================================================================
' Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486
' Compiled By Microsoft Professional Development System (PDS) BASIC 7.10
'=========================================================================
' Note -- Tabs in the source file are in positions 6,11,16,21,26,...
'=========================================================================
' $INCLUDE: 'cal1.bi'
ProgramVersion$ = "14.10" ' Version Number (ß just in case)
'=========================================================================
' Compiled as (modules CAL1 and CALU)
'
' "bc cal1 /e /o ; /cmd"
'
' Other Compiler Options For Other Modules
'
' Modules CAL2 through CAL6
' "bc cal2 /o; /cmd"
'
' Linked By Microsoft Segmented-Executable LINK Version 5.10
'
' "link stay4+cal1+cal2+cal3+cal4+cal5+cal6+calu+nocom+noevent+
' tscnionr,cal,cal,srp4+mhlib2+mhpro+mhpro7/e/noe ;"
'
' Linker Main Program -- stay4.obj from MicroHelp, Inc (Stay-Res 4)
' Linker Libraries -- srp4.lib from MicroHelp, Inc (Stay-Res 4)
' mhlib2.lib from MicroHelp, Inc (Mach2)
' mhpro.lib from MicroHelp, Inc (QB/Pro 1-4)
' mhpro7.lib from MicroHelp, Inc (QB/Pro 7)
'=========================================================================
' Appreciation to Herb Goertzel for his graphics ideas and some of his
' simple but brilliant mathematics.
'=========================================================================
' PROGRAM CAPABILITIES
'-------------------------------------------------------------------------
' Appointment File
' 20 to 300 Events -- Default 60
' 20 to 300 Notes -- Default 60
' Unlimited History
' Privacy
' Print or Copy to ASCII File -- Includes Current Calendars
' Event Management
' One-Time
' Repeating
' Daily, Bi/MultiWeekly, Biweekly, Monthly, Quarterly, Yearly
' Limited Number of Repeats
' Automatic Rescheduling
' Warnings and Alarms (Variable Music)
' Clock Screen
' Analog and Digital Time Display
' Event and Note Display Window
' Three-Month Calendar Display -- changable / scrollable
' User Interface
' Menu Driven
' Instructions on Screen
' Simple Commands
' Friendly
' Help for New Users is Automatic
' DOS Shell And Return
' Environment
' DOS 2.01a, 2.10, 3.00, 3.10, 3.20, 3.21, 3.30, 4.01
' IBM-PC, XT, AT, Clones
' Easy to Move and Reinstall
' Shareware $25 (12.75 and prior were free)
' Options
' Automatic Startup
' 7 Pairs of Color Choices on Color CRT (preset on Mono CRTs)
' Change DOS Date and Time
' Variable Clock Screen Footer for Notes and Events
' Variable Music Selection For Alarms, Warnings, and Chimes
' Variable Event Warning Time
' Variable Sound Choices
' Change Privacy Password
' Change Contents of Print or ASCII File
' Exclude Events from History
' Disallow Event Rescheduling on Weekends
' Printer Choice of IBM Color Graphics, Epson FX, IBM 4019 Laser,
' HP IIP/III/IIID Laser or User-Initialized
' Vary Capacity of Events and Notes
' Pop-Up/Pop-Down (Terminate and Stay Resident (TSR))
'-------------------------------------------------------------------------
' MAIN PROGRAM STRUCTURE (File CAL1.BAS)
' (requires /E because of global error handler and RESUME {linelabel})
'-------------------------------------------------------------------------
' Start MainSub (1)
' GlobalHandler Error Processor for All Modules
' Returns All Errors to MainSub (2) or (3)
' BuildMenuDate(EventDate$) For BuildMenuLine - Day/Date Function
' FileListGet For FileList - FILES Function
' GetApptRecord (Pointer) Get Appt File Record / Fix Null Record
' PlayStuff (PlayString$) Play Music
' ReadCalautoGet Get for ReadCalauto
' ReadCalDOSGet Get for ReadCalDOS
' ReadCalexclGet Get for ReadCalexcl
' ReadCalfigGet Get for ReadCalfig
' ReadCalinit (EntryPoint) Get initialization parameters
' ReadCalmusicGet Get for ReadCalmusic
' ReadCalresGet Get for ReadCalres
' ReadCalser Get validation data
' SetDateTimeGet (WhichType, DateTimeChange$) Change Date/Time
'-------------------------------------------------------------------------
' MAIN SUBPROGRAM INDEPENDENTLY COMPILED (File CAL2.BAS)
' (don't require /E or /X because global error handler in CAL1.BAS)
'-------------------------------------------------------------------------
' MainSub (MainEntryPoint)
' Definitions Entry Point 1
' One-Time Data Initialization
' Greeting Screen Entry Point 2
' Main Menu Entry Entry Point 3
' Open Event File
' Display Event Editing Menu
' Initialize Time Block
' Display Time Block
' Update Time And Date
' Check Table To Sound The Alarm
' Alarm Found
' Update Clock Display
' Sound The Alarm If Loaded
' Keystroke For Alternative Actions
'-------------------------------------------------------------------------
' SUBPROGRAMS INDEPENDENTLY COMPILED (File CAL3.BAS)
' (don't require /E or /X because global error handler in CAL1.BAS)
'-------------------------------------------------------------------------
' ApptToMenu (EntryPoint) Get Event Record to Menu Line Format
' Fn ASCIIN$ (ASCIIZString$) Strip Chr$(0) From ASCIIZ String
' Fn ASCIIZ$ (ASCIIString$) Add Chr$(0) to ASCII String
' AutoStart Automatic Startup Setting Menu
' BigChars (CharsLin%, CharsColumn%, ChLin$) Interface with MhChars
' BlankError Clear Error Message
' BlankFatal Clear Fatal Error (2 lines)
' Fn BlankFill$ (ToBlankFill$) Leading Zeroes to Blanks in String
' BoxDraw (Type, Top, Bottom, Left, Right) Draw Box with MhBox
' BuildMenuLine Construct Menu Event Line
' CheckDate (DatetoValidate$) See If Date Is Really a Date
' ClearLast3 Blank Last 3 Screen Lines
' ClearLast4 Blank Last 4 "
' ClearOverdueTable Clear Events Overdue Listing
' ClearScreenNormal (TimerDesired)
' Clear Screen with Cl1f,Cl1b colors
' CloseFiles Close All Data Files
' ColorDecode (ColorAttribute) Get Colors from Attribute
' CombineDateTime Merge Date/Time Fields
' CompressApptFile (ShrinkNumber)
' Compress Appt File ShrinkNumber Recs
' ComputePendingValue (AlarmValue#,PendingValue#)
' Calculate Warning Date/Time
' ControlledInput (BoxRow,BoxColumn,MessageRow,MessageColumn,Length,_
' MessageText$,InputResponse$,NumlockRequest,FilenameShow,_
' ScreenBottomsShow,HoldAtEnd) General Input Routine
' Credits (WhichLine) Address, Phone #, Price or Owner
' DayDate (DatetoIndex$) Get Day of Week and count for a Date
' Fn DirectoryExist(DirectoryName$) Interface with MhDirExist
' DirectReturnCheck Whether Returning To Clock Screen
' DisplayApptFilename Show Appointment File Name on Menus
' DOSBIOSServices Interface to MhDOS2
' DoShell (ShellCommand$) Run a Shell Command
' DOSShell Run DOS Session and Return
' EndItAll Return to DOS
' ErrorHandler Error Condition Message Generator
' EscapeLine Esc to Return Instruction
' EscapeLineDelete Esc to Return Instruction Blankout
' EventErrorMessage Display Error On Editing Instructions
' Fn FileExist(ExistFilename$) Interface with MhFileExist
' FileFormat Change Number of Notes/Events in File
' FileList Display List of Appointment Files
' GenerateGreeting Display Main Menu Greeting
' GenGreetingScreen1 Startup Screen
' GetFilenameLength Get Length of Appointment File Name
' GetOptions Read Options from Appointment File
' Help Help Function
' IncrementDate (DatetoIncrement$)
' Change a Date to the Next Date
' InitPrinter Initialize Printer w/Control Codes
'-------------------------------------------------------------------------
' SUBPROGRAMS INDEPENDENTLY COMPILED (File CAL4.BAS)
' (don't require /E or /X because global error handler in CAL1.BAS)
'-------------------------------------------------------------------------
' Fn InString Interface with MhInstr
' Instructions Bottom of Clock Screen Instructions
' KeyStuff (KeyFunction) Get a Keystroke, Display Key States
' KillAFile (KillFilename$) Interface with MhKill
' Kolors (WhichSetting) Change Color Setting
' Fn Leap (LeapInput) Check if Given Year is a Leap Year
' LprintString (PrintString$,HoldPrint)
' Send to Printer With Error Recovery
' MajorBeeper Severe Attention Music (Errors)
' MenuDriver (MenuSize, MenuChoice, MenuRow, MenuColumn,
' MenuSingleLine, MenuSpecialExit, ScreenBottomsShow, FilenameShow)
' Menu Processor
' MinorBeeper Mild Attention Music (Messages)
' MoveApptRecords
' (FileStart, MoveStart, MoveEnd, MoveIncr, MoveOrigin,
' MoveTarget, MoveFlag, BlankFlag, BlankAt)
' Shift Records In Appointment File
' Myd2 (Destin$, DestinStart%, Chars%, Source$)
' Interface with MhMidString (Statement)
' NotesHistory (NotesorHistory$)
' Change Notes and History Menu
' Fn NumberError (NumberTest$) Check for Non-Numeric Characters
' OpenAppts Open Appointment File and Set FIELD
' Options Options Menus
' PageEject Eject Printer Page
' PlayAlarmWarning (WarningSet)
' Play Alarm or Warning Music String
' PopLine F10 to Pop Down Prompt
' PopLineDelete Erase Pop Down Prompt
'-------------------------------------------------------------------------
' SUBPROGRAMS INDEPENDENTLY COMPILED (File CAL5.BAS)
' (don't require /E or /X because global error handler in CAL1.BAS)
'-------------------------------------------------------------------------
' PoppedOverCheck Check to See Whether Popped Over DOS
' PrepareforError Clear and Place for Error Message
' PrepareforFatal Prepare for QuickBASIC Error Message
' PrepareforMessage Clear and Place for Info Message
' PrintCalendar Display Three Months of Calendars
' PrintCopy Print or Copy Appointments to ASCII File
' ProcessAlarm Update Event and History Upon Alarm
' PutApptRecord (Pointer) Put Records in Appt File (Blank if 0)
' QuickSort (Low, High) Sort Alarm Table Routine
' QuitLine Ctl-ESC to Quit Instruction
' QuitLineDelete Ctl-ESC to Quit Instruction
' Fn RandInt% (Lower, Upper) Random integer from lower to upper
' ReadCalauto Read Auto Start CALAUTO.DAT File
' ReadCalDOS Read DOS Command CALDOS.DAT File
' ReadCalexcl Read Exclusion CALEXCL.DAT File
' ReadCalfig Read Colors CALFIG.DAT File
' ReadCalmusic Read CALMUSIC.DAT File
' ReadCalres Read CALRES.DAT File
' RefreshEventsNotes Display Clock Screen Footer
' RepackApptRecord Build Event Record From Fields
' RestoreCalKeyState Restore State of Ins,Caps,Num,Scrl
' RestoreDOSKeyState Restore State of DOS Ins,Caps,Num,Scrl
' ReturnLine Enter Instruction
' ReturnLineDelete Enter Instruction Blank Out
' SaveCurrentDirectory (EntryPoint)
' Get Program or User Directory
' SaveDOSKeyState Save State of DOS Ins,Caps,Num,Scrl
' ScreenBottoms Esc, Quit, and Return Instructions
' ScreenBottomsDelete Esc, Quit, and Return Instructions Blank
' SequenceEventsTable Sort Events Listing
' SetArrays Set Array Sizes Based Upon Event File
' SetColors Color Choice Menus
' SetCurrentDirectory (EntryPoint)
' Change to Current or User Directory
'-------------------------------------------------------------------------
' SUBPROGRAMS INDEPENDENTLY COMPILED (File CAL6.BAS)
' (don't require /E or /X because global error handler in CAL1.BAS)
'-------------------------------------------------------------------------
' SetDateTime Change DOS Date and Time
' SetOptions Write Options to Appointment File
' SetVideoMode (Why) Set User or Calendar Video Mode
' SetVideoPage (Why) Set Page Zero or User Page
' ShowErase (Kolor,ScreenRow,ScreenColumn,EraseFirst,ShowString$)
' Locate, Erase, and Display
' ShowIt (Kolor,ScreenRow,ScreenColumn,ShowString$)
' All Screen Displays
' ShowMult (Kolor,ScreenMultRow,ScreenColumn,EraseFirst,
' ScreenMultLines) ShowErase for Multiple Lines
' ShowOverduePage Display Excess Overdue Events
' Snooze (Secs!) Sleep for Seconds
' StayResInitialization Stay Res Plus Startup Code
' StayResKeyName Get English Hot Key Name
' StayResKeyShiftList For a Shift Code, Get Scan List Pointer
' StayResOptions (SrAutoOptions) Stay-Res Plus Options Menu/Check
' StayResPopDown (EntryPoint) Pop Down
' Fn Strng$ (RptTimes%, FillChar%) Replacement for STRING$ (MhString)
' Titles (NumberofLines) Generate Screen Titles (1 to 4 Lines)
' UnpackApptRecord Unpack Event Record to Fields
' UpdateClockScreen Change Date & Time On Clock Screen
' ValidateEventDate Check if Date Is Good
' VideoMonitorType Check Color or Monochrome Monitor
' WindowInit Initialize MhWind
' WindowRestore Restore User or Program Screen
' WindowSave Save User or Program Screen
' WriteCalauto Write Auto Startup CALAUTO.DAT File
' WriteCalDOS Write DOS Command CALDOS.DAT File
' WriteCalexcl Write Exclusion CALEXCL.DAT File
' WriteCalfig Write Color Choice CALFIG.DAT File
' WriteCalmusic Write CALMUSIC.DAT File
' WriteCalres Write CALRES.DAT File
' WritetoHistory Write Event to History (Check Exclusion)
' YearAdjust (YeartoAdjust,AdjustedYear$)
' Change Numeric Year To String Length 4
' Fn ZeroFill$ (ToZeroFill$) All Blanks to Zeroes in String
'-------------------------------------------------------------------------
' SUBPROGRAMS INDEPENDENTLY COMPILED (File CALU.BAS or CALSR.BAS)
' (don't require /E or /X because global error handler in CAL1.BAS)
'-------------------------------------------------------------------------
' ValidateUser (WhichLine) Registration
'-------------------------------------------------------------------------
' SUBPROGRAMS LINKED FROM MICROHELP QB/PRO 1-4 PACKAGE (MHPRO)
'-------------------------------------------------------------------------
' MhBackwardInstr Ctrl-Right-Left Implementation
' MhDirExist See If a Directory Exists
' MhFileExist See If a File Exists
' MhHexToInt Converts Hex String to Integer
' MhInstr Replaces INSTR
' MhIntToString STR$ Replacement for Integers
' MhKill Delete A File without Errors
' MhLprint Line Printer Support
' MhLset Replacement for LSET Statement
' MhMidString Replacement for MID$ Statement (Myd2)
' MhNotBackwardInstr Ctrl-Right-Left Implementation
' MhNotInstr Ctrl-Right-Left Implementation
' MhRename Rename a File (replaces NAME)
' MhString Replacement for STRING$ (see Strng$)
' MhToggleBits Registration
'-------------------------------------------------------------------------
' SUBPROGRAMS LINKED FROM MICROHELP QB/PRO 7 PACKAGE (MHPRO7)
'-------------------------------------------------------------------------
' Mh80x25 Change screen size to 25 lines
' Mh80x43 Change screen size to 43 lines
' Mh80x50 Change Screen size to 50 lines
'-------------------------------------------------------------------------
' SUBPROGRAMS LINKED FROM MICROHELP MACH2 PACKAGE (MHLIB2)
'-------------------------------------------------------------------------
' MhBox Box Display
' MhChars Large Character Display
' MhColorAttribute Compute Color Attribute
' MhDir Directory Services
' MhDisk Check Disk Free Space
' MhDisplay Display Mode Test
' MhDos2 Get Cursor Information
' MhDver Get DOS Version Number
' MhGetKbStatus1 Caps/Num Status Check
' MhGetKbStatus2 Insert Pressed Check
' MhInstat Keystroke Buffer Check for Traps & Exit
' MhSetKBStatus Keyboard State Change
' MhScr Screen Display
' MhWind Window Manager for Screen Save/Restore
'-------------------------------------------------------------------------
' SUBPROGRAMS LINKED FROM MICROHELP STAYRES PLUS (STAY4.OBJ & STAY4.LIB)
'-------------------------------------------------------------------------
' SrAutoScreenSave (FileName$, Ecode%)
' SrCancelAutoScreenSave ()
' SrCancelShell ()
' SrCheckEMS (Ecode%)
' SrForceFile0 ()
' SrNoSnow ()
' Fn SrOverDos% ()
' SrPopDown (Kscan%, Kshift%, Ecode%)
' SrReleaseMem (Ecode%)
' SrReleaseTimeY ()
' SrResetHotkey (Kscan%, Kshift%)
' SrResidentBatch (CmndLine$, Ecode%)
' SrResidentShell (CmndLine$, Ecode%)
' SrSetBusyWait (Ticks%)
' SrSetCom (Port%, Ecode%)
' SrSetDiskSwap (FileName$, Ecode%)
' SrSetId (IDName$, IDNumber%, Ecode%)
' SrSetPokeChar (Ascii%)
' SrSetTimeY (Month%, Day%, Year%, Hour%, Minute%)
' SrSetUserMem (Bytes&)
' SrSetVideoMode (Mode%)
' SrUseErrorTable ()
'=========================================================================
ON ERROR GOTO GlobalHandler
Subnum = 0
CurrentStackSize& = 4000& 'Larger Stack for Recursion
STACK CurrentStackSize& ' May increase it later
CALL MainSub (1) ' Main Program Starts
'=========================================================================
'#########################################################################
'#########################################################################
'=========================================================================
' Control NEVER Returns Here, Except to Use the Global Error Handler
'=========================================================================
' GLOBAL ERROR HANDLER FOR ALL MODULES
'=========================================================================
' This is the ONLY module-level error handler in CAL. It takes advantage
' of the BASIC feature to trace back through the CALL stack to an active
' handler. Control is returned to MainSub in CAL2, which is truly a
' recursive procedure (i.e. CALL'd when already active)
'=========================================================================
GlobalHandler: ' Enter the Global Handler
CALL ErrorHandler ' Construct the error messages
'--------------------- ' Reset all critical variables
RESUME ErrorStatusOff ' Resume to go back to MainSub
ErrorStatusOff: ' resetting stack if it's too low
ON ERROR GOTO GlobalHandler
'=========================================================================
' Check the Stack to make sure it's not too low. Increase it if it falls
' below 3000 bytes by 1500 at a time.
'---------------------
NewStackSize& = CurrentStackSize& + 1500& ' Proposed New Size
IF STACK => NewStackSize& THEN ' If Stack Can Grow And
IF FRE(-2) <= 3000& THEN ' and if stack space is low
CurrentStackSize& = NewStackSize&
STACK CurrentStackSize& ' then increase it
END IF
END IF
'=========================================================================
' Return to main menu ' Make no mistake ... if we've come
IF PrimitiveState THEN ' here, we're preparing for a
LOCATE 19, N1 ' recursive call to MainSub, which adds
PRINT ErrorLine1$ ' about 50-60 bytes to the stack
PRINT ErrorLine2$
PRINT "Program initialization is incomplete. Cannot proceed."
SYSTEM
ELSEIF StartupScreenHold THEN
CALL MainSub(N2) ' Resumes at StartupScreenExit
ELSE
CALL MainSub(N3) ' Resumes at MainMenuEntry
END IF
'=========================================================================
'#########################################################################
'#########################################################################
'=========================================================================
' Control NEVER Gets Here--Program Terminates in EndItAll
'=========================================================================
'=========================================================================
' SUBs That Require Error Handling Do The Minimum Necessary Here
'=========================================================================
SUB BuildMenuDate(BuildEventDate$) STATIC
'=========================================================================
DEFINT A-Z
' For BuildMenuLine
SubnumSave = Subnum
Subnum = 124
ON LOCAL ERROR GOTO DateError
CALL DayDate(BuildEventDate$)
DateResume:
ON LOCAL ERROR GOTO 0
EXIT SUB
Subnum = SubnumSave
DateError:
ErrorSwitch = Yes
RESUME DateResume
END SUB
'=========================================================================
SUB FileListGet STATIC
'=========================================================================
DEFINT A-Z
' Error Handling for FileList (FILES Function)
SubnumSave = Subnum
Subnum = 125
ON LOCAL ERROR GOTO FilesError
FILES "*.cld"
FilesResume:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
FilesError:
IF ERR = 53 THEN
ErrorSwitch = Yes
RESUME FilesResume
ELSE
ERROR ERR
END IF
END SUB
'=========================================================================
SUB GetApptRecord (Pointer) STATIC
'=========================================================================
' Get a Record From the Appointment File
' If a Null String Then Replace it by Blanks
DEFINT A-Z
SubnumSave = Subnum
Subnum = 107
ON LOCAL ERROR GOTO GetError
GET FilenumAppt, Pointer
GetResume:
ON LOCAL ERROR GOTO 0
IF ErrorSwitch THEN
ErrorSwitch = No
CALL OpenAppts
GET FilenumAppt, Pointer
END IF
IF ApptBuffer$ = ZeroLine THEN ' Replace Null Record
CALL MhLset (ApptBuffer$, Blank80$)
CALL PutApptRecord(Pointer)
END IF
IF Pointer > N1 AND Pointer <= NumberOfEvents + N1 THEN
CurrentEventRecord$ = ApptBuffer$
WhichEvent = Pointer - N1
END IF
Subnum = SubnumSave
EXIT SUB
GetError:
IF ERR = 52 THEN
ErrorSwitch = Yes
RESUME GetResume
ELSE
ERROR ERR
END IF
END SUB
'=========================================================================
SUB PlayStuff (PlayString$) STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 109
MFore$ = "mf"
MBack$ = "mb"
ActualPlayString$ = PlayString$
IF MemoryResident THEN ' No Background Music if Resident
DO
MBPos = InString(LCASE$(ActualPlayString$), MBAck$)
IF MBPos THEN
CALL Myd2(ActualPlayString$, MBPos, N2, MFore$)
END IF
LOOP WHILE MBPos
END IF
ON LOCAL ERROR GOTO PlayError
PLAY "X" + VARPTR$(ActualPlayString$)
PlayResume:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
PlayError:
ErrorSwitch = Yes
RESUME PlayResume
END SUB
'=========================================================================
SUB ReadCalautoGet STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 126
ON LOCAL ERROR GOTO AutoInputError2
INPUT #FilenumAuto, ApptFilename$, ApptPassword$, AutoMode$, ForceDate
AutoResume2:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
AutoInputError2:
IF ERR <> 62 THEN
ERROR ERR
ELSE
' Input Record Too Short
ErrorSwitch = Yes
RESUME AutoResume2
END IF
END SUB
'=========================================================================
SUB ReadCalDOSGet STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 127
ON LOCAL ERROR GOTO DOSError2
INPUT #FilenumDOS, DOSCommand$
DOSResume2:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
DOSError2:
IF ERR <> 62 THEN
ERROR ERR
ELSE
' Input Record Too Short
ErrorSwitch = Yes
RESUME DOSResume2
END IF
END SUB
'=========================================================================
SUB ReadCalexclGet STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 128
ON LOCAL ERROR GOTO ExclError2
FOR J = N1 TO N2
INPUT #FilenumExcl, ExcludefromHistory$(J)
NEXT
ExclResume2:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
ExclError2:
IF ERR <> 62 THEN
ERROR ERR
ELSE
' Input Too Short
ErrorSwitch = Yes
RESUME ExclResume2
END IF
END SUB
'=========================================================================
SUB ReadCalfigGet STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 129
ON LOCAL ERROR GOTO FigError
' Read 7 Color Pairs (or whatever an old file has)
INPUT #FilenumFig, Chf, Chb, Cl1f, Cl1b, Cl2f, Cl2b, _
Cl3f, Cl3b, Cl4f, Cl4b, Cl5f, Cl5b, Cl6f, Cl6b
FigResume:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
FigError:
IF ERR <> 62 THEN
ERROR ERR
ELSE
' Input Too Short
ErrorSwitch = Yes
RESUME FigResume
END IF
END SUB
'=========================================================================
SUB ReadCalinit (EntryPoint) STATIC
'=========================================================================
DEFINT A-Z
' Any error in this sub is fatal, so no need for fancy error handling
ON LOCAL ERROR GOTO InitError
SELECT CASE EntryPoint
CASE 1
OPEN "I", #FilenumInit, "calinit.dat"
' Res initialization
FOR I = N1 TO 4
FOR J = N1 TO NumberofHotFKeys
INPUT #FilenumInit, FunctionScanCodes(I, J)
NEXT J
NEXT I
FOR I = N1 TO NumberofHotCKeys
INPUT #FilenumInit, HotKeyNames$(I)
NEXT
FOR I = N1 TO 20
INPUT #FilenumInit, ScreenModes$(I)
NEXT
CASE 2
'
FOR I = N1 TO 12
INPUT #FilenumInit, JulianDays(I)
NEXT
'
FOR I = N1 TO 12
INPUT #FilenumInit, MonthLength(I)
NEXT
'
FOR I = N1 TO 12
INPUT #FilenumInit, MonthNames$(I)
NEXT
'
FOR I = N1 TO N7
INPUT #FilenumInit, DayNames$(I)
NEXT
'
FOR I = N1 TO 4
INPUT #FilenumInit, DateEditLimits(I)
NEXT
'
FOR I = N1 TO 16
INPUT #FilenumInit, Colors$(I)
NEXT
'
FOR I = N1 TO N7
INPUT #FilenumInit, ColorPairUses$(I)
NEXT
'
FOR I = N1 TO N2
INPUT #FilenumInit, ColorPairTypes$(I)
NEXT
'
FOR I = N1 TO 4
INPUT #FilenumInit, SoundLevels$(I)
NEXT
ScreenTag$ = SoundLevels$(4)
'---------------------------------------------------------------
' Read Printer Code Arrays
' IBM
FOR I = N1 TO 50
INPUT #FilenumInit, IBMCodes(I)
IF IBMCodes(I) = -99 THEN EXIT FOR
NEXT
'---------------------------------------------------------------
' Epson Printer
FOR I = N1 TO 50
INPUT #FilenumInit, EpsonCodes(I)
IF EpsonCodes(I) = -99 THEN EXIT FOR
NEXT
'---------------------------------------------------------------
' HP IIP or III or IIID Laser Printers
FOR I = N1 TO 50
INPUT #FilenumInit, HPIIPCodes(I)
IF HPIIPCodes(I) = -99 THEN EXIT FOR
NEXT
'---------------------------------------------------------------
' IBM 4019E or 4019-01 Laser Printers
FOR I = N1 TO 50
INPUT #FilenumInit, I4019Codes(I)
IF I4019Codes(I) = -99 THEN EXIT FOR
NEXT
'===============================================================
' Initialize The Clock Display (Herb's Graphics Modified)
'===============================================================
FOR I = N1 TO N3
INPUT #FilenumInit, ClockGraphics(I)
NEXT
'===============================================================
FOR I = N1 TO 8
FOR J = N1 TO 4
INPUT #FilenumInit, EditInstructions(I, J)
NEXT J
NEXT I
'===============================================================
FOR I = N1 TO 4
INPUT #FilenumInit, EventInput(I)
NEXT
'===============================================================
FOR I = N1 TO 4
INPUT #FilenumInit, NoteInput(I)
NEXT
'===============================================================
FOR I = N1 TO N3
INPUT #FilenumInit, EventInstructions1(I)
NEXT
FOR I = N1 TO N3
INPUT #FilenumInit, EventInstructions2(I)
NEXT
INPUT #FilenumInit, EventInstructions3
FOR I = N1 TO 4
INPUT #FilenumInit, NoteInstructions1(I)
NEXT
FOR I = N1 TO N3
INPUT #FilenumInit, NoteInstructions2(I)
NEXT
INPUT #FilenumInit, NoteInstructions3
FOR I = N1 TO N3
INPUT #FilenumInit, EventNoteSharedIns(I)
NEXT
'===============================================================
CLOSE #FilenumInit
END SELECT
ON LOCAL ERROR GOTO 0
EXIT SUB
InitError:
CLS
PRINT
PRINT " Initialization Data File CALINIT.DAT Is Defective Or Unavailable "
SYSTEM
END SUB
'=========================================================================
SUB ReadCalmusicGet STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 130
ON LOCAL ERROR GOTO MusicError2
INPUT #FilenumMusic, Alarm$, Chime$, Warning$
MusicResume2:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
MusicError2:
IF ERR <> 62 THEN
ERROR ERR
ELSE
' Input Too Short
ErrorSwitch = Yes
RESUME MusicResume2
END IF
END SUB
'=========================================================================
SUB ReadCalresGet STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 131
ON LOCAL ERROR GOTO ResError
' Read Stay-Res Options if File is There
' SrInitials$ is no longer used in SRP4, hence a throw-away
INPUT #FilenumRes, EverResident$, UserPopDateTime$, _
UseDiskSwap$, UseEMS$, SrSwapPath$, SrInitials$, _
SrKscanHot, SrKshiftHot, SrAutoPopDown, SrSnowCheck, _
SrPopupOnlyIfScreenSaved
ResResume:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
ResError:
IF ERR <> 62 THEN
ERROR ERR
ELSE
' Input Too Short
ErrorSwitch = Yes
RESUME ResResume
END IF
END SUB
'=========================================================================
SUB ReadCalser STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 141
IF FileExist("calser.dat") THEN
Registered = Yes
OPEN "I", #FilenumSer, "calser.dat"
ON LOCAL ERROR GOTO SerError
' Read Registration Data
LINE INPUT #FilenumSer, RegiData$
ELSE
Registered = No
END IF
SerResume:
ON LOCAL ERROR GOTO 0
CLOSE #FilenumSer
Subnum = SubnumSave
EXIT SUB
SerError:
IF ERR <> 62 THEN
ERROR ERR
ELSE
' Input Too Short
ErrorSwitch = Yes
RESUME SerResume
END IF
END SUB
'=========================================================================
SUB SetDateTimeGet (WhichType, DateTimeChange$) STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 132
ON LOCAL ERROR GOTO DateTimeError
IF WhichType = N1 THEN
DATE$ = DateTimeChange$
ELSE
TIME$ = DateTimeChange$
END IF
DateTimeResume:
ON LOCAL ERROR GOTO 0
Subnum = SubnumSave
EXIT SUB
DateTimeError:
ErrorSwitch = Yes
RESUME DateTimeResume
END SUB
'========================================================================
'======================== END OF CAL1.BAS =============================
'========================================================================